home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / gt_power / gtuser11.zip / GTUSERTS.PAS < prev    next >
Pascal/Delphi Source File  |  1990-11-12  |  4KB  |  143 lines
  1. program GTUserTest;
  2. { Simple program to test and demonstrate operation of 'GTUSER' unit - which
  3.   allows easy access to the contents of GT-PowerComm's GTUSER.BBS door
  4.   program information file for Turbo Pascal programmers.
  5. }
  6. uses
  7.    CRT,
  8.    GTUSER;
  9. var
  10.    User_Details : GTUSER_BBS_Details;
  11.    Quit_Char : string;
  12.  
  13.  
  14. procedure Display_Authorisations(AS : Authorisation_Set);
  15. { Sample of how to check and display current user's authorisations. In a
  16.   "real" application, you could code something like :
  17.                Allow_shell_to_DOS := (SY in AS) or (SH in AS);
  18. }
  19. const
  20.    Num_Auths = 16;
  21.    AU_Val : array[1..Num_Auths] of Authorisations =
  22.      ( UP , DN , PR , KL , SY , CH , SH , DR , MS , FA ,
  23.        FR , NL , NE , CB , NP , DX);
  24.    AU_Desc : array[1..Num_Auths] of string [79] =
  25.      ('UP : Uploads permitted',
  26.       'DN : Downloads permitted',
  27.       'PR : You may enter private mail',
  28.       'KL : You can K)ill messages like sysop',
  29.       'SY : As SYSOP, you are omnipotent!',
  30.       'CH : Manual dir. change allowed (if GTDIR.BBS not in use)',
  31.       'SH : Shell to DOS allowed',
  32.       'DR : Use of DOORs is permitted',
  33.       'MS : You may read messages',
  34.       'FA : You are allowed to FileAttach when netmailing',
  35.       'FR : You are allowed to FileRequest when netmailing',
  36.       'NL : L)ist directory main menu option disabled',
  37.       'NE : You may NOT Enter messages',
  38.       'CB : CB simulator may be used',
  39.       'NP : Sysop page disabled',
  40.       'DX : Delivery authorised');
  41. var
  42.    i : byte;
  43. begin
  44.     { This is a neat way to display values of enumerated data types }
  45.     for i := 1 to Num_Auths
  46.     do
  47.        if AU_Val[i] in AS
  48.        then
  49.           writeln('':5,AU_Desc[i])
  50. end; { Display_Authorisations }
  51.  
  52.  
  53. procedure Zero_Fill(var s : string);
  54. { Turns all blanks in 's' to zeros }
  55. var
  56.    i : byte;
  57. begin
  58.    for i := 1 to length(s)
  59.    do
  60.       if s[i] = ' '
  61.       then
  62.          s[i] := '0'
  63. end; { Zero_Fill }
  64.  
  65.  
  66. function Date_To_Str(Date : GTUSER_Date_Type) : string;
  67. { Display a date from GTUSER }
  68. var
  69.    Build_Str, Temp_Str : string;
  70. begin
  71.    Str(Date.DD:2,Build_Str);
  72.    Str(Date.MM:2,Temp_Str);
  73.    Build_Str := Build_Str + '/' + Temp_str;
  74.    Str(Date.YYYY:4,Temp_Str);
  75.    Build_Str := Build_Str + '/' + Temp_str;
  76.    Zero_Fill(Build_Str);
  77.    Date_To_Str := Build_Str
  78. end; { Date_To_Str }
  79.  
  80.  
  81. function Time_To_Str(Time : GTUSER_Time_Type) : string;
  82. { Display a time from GTUSER }
  83. var
  84.    Build_Str, Temp_Str : string;
  85. begin
  86.    Str(Time.HH:2,Build_Str);
  87.    Str(Time.MM:2,Temp_Str);
  88.    Build_Str := Build_Str+':'+Temp_str;
  89.    Str(Time.SS:2,Temp_Str);
  90.    Build_Str := Build_Str+':'+Temp_str;
  91.    Zero_Fill(Build_Str);
  92.    Time_To_Str := Build_Str
  93. end; { Time_To_Str }
  94.  
  95.  
  96. procedure DisplayUserDetails(UD : GTUSER_BBS_Details);
  97. { Pretty useless demo procedure to show extraction of information from
  98.   record generated by GTUSER unit }
  99. begin
  100.    clrscr;
  101.  
  102.    writeln('Current (or most recent) user details :');
  103.    writeln;
  104.  
  105.    writeln('Level               : ',UD.Level);
  106.    writeln('Name                : ',UD.First_name,' ',UD.Last_name);
  107.  
  108.    writeln;
  109.    writeln('Authorisations      : ');
  110.    Display_Authorisations(UD.Authorisation);
  111.    writeln;
  112.  
  113.    write  ('Communication Rate  : ');
  114.    if UD.DCE_Baud = 0
  115.       then writeln('N/A (local test call)')
  116.       else writeln('DCE = ',UD.DCE_Baud,' bps, DTE = ',UD.DTE_Baud,' bps');
  117.  
  118.    write  ('ANSI                : ');
  119.    if UD.ANSI_Opt
  120.       then writeln('Yes')
  121.       else writeln('No');
  122.  
  123.    writeln('Last on (DD/MM/YYYY): ',Date_To_Str(UD.Date_Last_On));
  124.    writeln('Remaining this call : ',UD.Limit:5,' min ');
  125.    writeln('Next "event" in     : ',UD.Event:5,' min ');
  126.    writeln('GTUSER.BBS time is  : ',Time_To_Str(UD.Current_Time));
  127. end; { User_Details }
  128.  
  129.  
  130. begin
  131.    DirectVideo := false;
  132.    Quit_Char := '';
  133.  
  134.    repeat
  135.       GetGTUSERDetails(User_Details);
  136.  
  137.       DisplayUserDetails(User_Details);
  138.  
  139.       writeln;
  140.       write('Press <ENTER> to refresh details, or enter "Q" to exit ');
  141.       readln(Quit_Char)
  142.    until ((length(Quit_char) > 0) and (upcase(Quit_Char[1]) = 'Q'));
  143. end.